#lex.pm
#Loads a lexicon and processes a lexicon look-up
#Method list:
# new(\@ARGV);					constructor, takes the pointer to the command line option array
# loadlex(\$CL-OBJECT);				a method which loads the lexicon. takes a pointer to the commandline object (PRIVATE)
# searchBin($OBJECT, $WORD, $INICIAL, $FINAL)	a recursive binary search method. takes the current lex class instance, the entry to find, the inicial and the final search values (PRIVATE)
# getLexPath();					a method which returns the current lexicon path (PUBLIC)
# checkEntry($WORD);				returns an entry knowledge of the second column in the lexicon (PUBLIC)

#Version: 1.0
#@autor: Igor Jauk

package lex;
use FindBin qw($Bin);
use lib "$Bin/../libs";
use config;

sub new {
	my $object = shift;
	my $AR = shift;
	my $ref = {};
	bless($ref, $object);
	my $cl = config->new($AR);
	$ref->loadlex(\$cl);
	return($ref);
}

sub loadlex {
	my ($object, $cl) = @_;
	$object->{lexpath} = "$Bin/../libs/boss-bomp/240310_boss-bomp-b-utf-8.txt";
	if ($$cl->optionarg("-lex") ne "") {
		$object->{lexpath} = $$cl->optionarg("-lex");
	}
	open IN, "$object->{lexpath}" or die "could not open lexicon file $object->{lexpath}. terminating\n";
	chomp(my @data = <IN>);
	close(IN);
	for (my $i=0; $i<@data; $i++) {
		$data[$i] = lcfirst($data[$i]);
	}
	@data = sort(@data);
	#my $oldw = "";
	#my $oldtr = "";
	for (my $i=0; $i<@data; $i++) {
		my @buff = split(/\t+/,$data[$i]);
		$object->{left}[$i] = $buff[0];
		$object->{right}[$i] = $buff[1];
		
		#prints out entries, which have the same orthography but different transcriptions (activate $oldw and $oldtr above)
		#if ($buff[0] eq $oldw && $buff[1] ne $oldtr) {
		#	print $data[$i-1]."  -----   ".$data[$i]."\n";
		#}
		#$oldw = $buff[0];
		#$oldtr = $buff[1];
	}
	print "lexicon with ".getLexPath($object)." loaded. lexicon length is ".@data." entries.\n";
}

sub getLexPath {
	my ($object) = @_;
	return $object->{lexpath};
}

sub checkEntry {
	my ($object, $word) = @_;
	$word = lcfirst($word);
	my $inicio = 0;
	my $final = @{$object->{left}};
	my $result = searchBin($object, $word, $inicio, $final);
	return $result;
	
	#linear search
	#for (my $i=0; $i<@{$object->{left}}; $i++) {
	#	if ($object->{left}[$i] eq $word) {
	#		return $object->{right}[$i];
	#	}
	#}
	#return 'no transcription found';
}

sub searchBin {
	my ($object, $word, $inicio, $final) = @_;
	my $centro = ($inicio + $final) / 2;
	my $trans;
	if ($object->{left}[$centro] eq $word) {
		$trans = $object->{right}[$centro];
		if ($object->{left}[$centro-1] eq $word && $object->{right}[$centro-1] ne $trans) {
			$trans = $trans."||||".$object->{right}[$centro-1];
		}
		if ($object->{left}[$centro+1] eq $word && $object->{right}[$centro+1] ne $trans) {
			$trans = $trans."||||".$object->{right}[$centro+1];
		}
		return $trans;
	} elsif ($object->{left}[$centro] gt $word) {
		if ($inicio > $final) {
			$trans = 'no transcription found';
			return $trans;
		}
		$final = $centro - 1;
		searchBin($object, $word, $inicio, $final);
	} elsif ($object->{left}[$centro] lt $word) {
		if ($inicio > $final) {
			$trans = 'no transcription found';
			return $trans;
		}
		$inicio = $centro + 1;
		searchBin($object, $word, $inicio, $final);
	} else {
		$trans = 'no transcription found';
		return $trans;
	}
}

1;